Pascal Super Library/Pascal Super Library (CW International)(1997).bin/LIBRARY/WAFPEGTP/WAFPEG.PAS

Pascal/Delphi Source File | 1994-08-20 | 33KB | 1,027 lines

{$A+,B-,D-,E-,F-,I-,L-,N-,O-,R+,S+,V-}
{$M 65000,0,10000}
program wafpeg;

{
    Take incoming mail from waffle 1.65 user mailboxes and splatter into
    individual PMail compatible .cnm mail items. Part of wafpeg udg.
    Copyright (C) 1992  Dr Ross Lazarus

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 1, or (at your option)
    any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

    Dr Ross Lazarus is the original copyright holder of this code.
    Email: [e-mail]
    Mail: Department of Community Medicine,
          Westmead Hospital
          Westmead, NSW 2145
          Australia
    Fax: [phone]


+ hacked 20/august 1994 rml to get rid of pmuser in stand alone mode.

+ modified for public release of code excluding the unit needed for remote
  server mapping. Single MUST be defined. rml 16 january 1994

+ modified rfc822 date to include tz rml 4/april 1993

+ additional parameter for standalone added - a which forces all mail into
  the pmuser environment variable mailbox if present in standalone mode
  rml 6/march 1993

+ standalone mode added 17/2/93 rml

+ major rewrite of mailbox splatter code to use index file
  necessitated by the complexities of what might be in there
  a major bunch of bugs and code changed ! 20/8/92 rml

+ major reshuffle of delivery code to permit MULTIPLE forward addresses
  in forward.p - each line not starting with # assumed to be server/user
  if server is blank, assumed to be on gateway 20/8/92 rml

+ made log file a little more like uucico's 13/8/92

+ added rfc822 dates in received by lines 10/8/92

+ added parameter types - eg /Nf:\mail for f:\mail as network
  mail drive, /d - nokill/debug /? - help /p = remote password
  /u = remote user rml 9/8/92

+ added detach code from remote server rml 8/8/92

revision 6 adds the option of forwarding to remote servers - if the
users waffle directory contains a forward file called forward.p.
with an entry of the form
fileservername/user
stuff is delivered to that user's novell mailbox.
Possible to fake forwarding to the same server, but the userid logged in
while this programming is running needs cws access to sys:mail
The userid and password to be used on the remote server must be passed
to this program for that to work. Default is guest with no password

revision 5 takes all spaces out of static file lines before looking
for spool: in the waffle static file - upper case used to avoid
problems.

revision 4 reads waffle environmental variable and gets waffle
user directory directly from the static file

reads waffle 1.65 mailboxes from the subdirectories of a waffle user
directory (from the Waffle static file) and parses and writes the contents
to the users mail directory in Pegasus mail compatible files in a network
mail directory (user supplied parameter). The waffle user subdirectory name
is the waffle user name. Looks in the netware bindery for a user of the SAME
name and uses the netware hexid as the network users mail subdirectory.
Assumes that each subdir of the supplied waffle user directory
has a name which is also the network name for that user
rml
june 1992
known bugs : contact [e-mail] with your finds !
}


{$define single}
(*
To compile this public code release, single MUST be defined. Otherwise
you need remote novell server login/map code which will be provided for
an appropriate fee to those wanting it
*)
{$ifdef single}
uses dos,crt,novell,awindow;
{$else}
uses dos,crt,novell,novell2,awindow;
{$endif}

const
     copyright = 'Copyright (C) Dr Ross Lazarus, August 1992';
     copyright2 = 'All rights reserved. Unauthorised use and distribution prohibited';
     standalone : boolean = false;
     pmenv = 'PMUSER';
     debug : boolean = false;
     logdirs : boolean = false;
     some : boolean = false;
     allmail : boolean = false;
     prog = 'WafPeg';
     ver = '0.27s, 94.08.20';
     waffleset = 'WAFFLE';
     userdirtag = 'USER:';
     hosttag = 'NODE:';
     tztag = 'TIMEZONE:';
     forwardfilename = 'FORWARD.P';
     wafdir : string = '\waffle\system\static';
     progname = 'Waffle 1.65 mailbox --> Pegasus Mail Converter';
     version = 'Version ' + ver + ', [e-mail]';
     killfile : boolean = true; { controls deletion of old mailboxes }
     pmailext = '.CNM'; { new mail file extension }
     userdir : string = 'c:\waffle\user'; { default }
     netmaildir : string = 'f:\mail';
     remotedrive = 'M:';
     remotemapping = remotedrive + '=sys:';
     remuser : string = 'guest';
     rempass : string = '';
     userobject = 1;
     remotenetmaildir : string = remotedrive + '\mail';
     mb = 'mailbox.f'; { name of mailbox text file }
     omb = 'orphan.f'; { orphaned mail }
     mbi = 'mailbox.i';
     maxbuf = 16384;

type
    hexidtype = array[1..4] of byte;
    windex = record { a waffle mailbox index file record }
                   offset : longint;
                   length : longint;
                   stuff : array[1..28] of byte;
             end;

var
   i,j,defaultserverid,dummy : integer;
   s,timezone,hostname,gateservername,homedir : string;
   c : char;

function mirt(trime : String) : String;
{ trim all blanks }

const
     blank = ' ';

var
   l : integer;
   t : string;

begin
     t := '';
     for l := 1 to length(trime) do
         if (trime[l] <> blank) then
            t := t + trime[l];
     mirt := t;
end; { mirt }

function UpcaseStr(S : String) : String;
(* converts a string to upper case *)

var
  P : Integer;
begin
  for P := 1 to Length(S) do
    S[P] := Upcase(S[P]);
  UpcaseStr := S;
end; { Upcasestr }

function before(sep : string ; s : string) : string;
{
return characters up to sep in s
if no sep, return whole of s
}
var
   i : integer;

begin
     i := pos(sep,s);
     if (i = 0) then
        before := s
     else
         before := copy(s,1,pred(i));
end;

function after(sep :string ; var s : string) : string;
{
return characters after sep in s
if no sep, returns null string
}

var
   i,j,l : integer;

begin
     l := length(s);
     j := length(sep);
     i := pos(sep,s);
     while (copy(s,i+j,j) = sep) and (i < l) do
           inc(i,j);
     if (i = 0) or (i >= l)  then
        after := ''
     else
         after := copy(s,i + j,999);
end; { after }


{---------------- date and time support ------------------}
const
     daypos = 1;
     monthpos = 3;
     Limit      : Array[1..13] of Integer = (31,29,31,30,31,30,31,31,30,31,30,31,31);
     MthTab     : Array[1..12] of String[9] = ('Jan','Feb','Mar',
                                             'Apr','May','Jun','Jul',
                                             'Aug','Sep','Oct',
                                             'Nov','Dec');
     DayTab     : Array[0..6] of String[9] = ('Sun','Mon','Tue',
                                            'Wed','Thu','Fri',
                                            'Sat');

Function SysTime : String;
Var
  H, M, S : String[2];
  hh,mm,ss,s100 : word;

Begin
     gettime(hh,mm,ss,s100);
     Str(hh:2, H);
     Str(mm:2, M);
     Str(ss:2, S);
     if H[1] = ' ' then H[1] := '0';
     if M[1] = ' ' then M[1] := '0';
     if S[1] = ' ' then S[1] := '0';
     SysTime := H + ':' + M + ':' + S
End;


Function rfc822date : String;

Var
  I     : Integer;
  S1,S2,today : String[30];
  dd,mm,yy,d,hh,ss,s100 : word;
  ds : string[2];
  ys : string[4];
  status,mn : integer;

Begin
  getdate(yy,mm,dd,d);
  str(dd,ds);
  str(yy,ys);
  S1 := daytab[D]+', ' + mirt(ds) + ' ' + mthtab[mm] + ' ' + ys;
  rfc822Date:= s1 + ' ' + systime + ' ' + timezone;
End;


function findwuserdir : string;
{
find waffle static file from environmental variable
and read to locate user dir
}
var
   infile : text;
   wuserdir,tmpstring : string;
   uppers : string;
   ufound,hfound,tzfound : boolean;
   c : char;


function find(id,usource,source : string; var dest : string) : boolean;
{
seek id in the source string
if found, return whatever starts with the first alphabetic character
after the id label
}

var
   temps : string;

function alphaafter(sep,ups,s : string ) : string;
{
return first alpha characters after sep in s
if no sep, returns null string
uses uppercase version of sep and s to find substring
}

const alpha : set of char = ['0'..'9','A'..'z'];

var
   i,j,l : integer;
   rets : string;

begin { alphaafter }
     sep := upcasestr(sep);
     rets := '';
     l := length(s);
     j := length(sep);
     i := pos(sep,ups);
     if (i <> 0) then
     begin
          i := i + j;
          while not (ups[i] in alpha) and (i < l) do
                inc(i);
          if (i > 0) and  (i <= l)  then
             rets := copy(s,i,l);
     end; { not there }
     alphaafter := rets;
end; { alphaafter }


begin { find }
      if (pos(id,usource) <> 0) then
      begin
           dest := '';
           temps := alphaafter(id,usource,source);
           if (temps = '') then
           begin
                writeln(systime,' No ',id,' specified in ',wafdir);
                halt(1);
           end
           else
           begin
               dest := temps;
               find := true;
           end;
      end { leave dest alone if id not found }
      else
          find := false;
end; { find }


begin { findwuserdir }
(*
 *    Waffle uses an environment variable (WAFFLE) to point at the
 *    static parameters file
*)
     hfound := false;
     ufound := false;
     tzfound := false;
     timezone := '(??tz) ';
     hostname := '?(NODE: not found in Waffle static file)';
     wafdir := getenv(waffleset);
     if (wafdir = '') then
     begin
           writeln(progname,' invoked ',rfc822date);
           writeln(version);
           writeln(systime, ' ERROR: WAFFLE environment variable has not been defined');
           writeln('PLEASE read the Waffle DOS documentation !!!');
           writeln(prog,' halting abnormally - dos error code = 1');
           halt(1);
     end;
     {$i-}
     assign(infile,wafdir);
     reset(infile);
     {$i+}
     dummy := ioresult;
     if (dummy <> 0) then
     begin
          writeln(progname,' invoked ',rfc822date);
          writeln(version);
          writeln(systime ,' ERROR: Waffle static file ',wafdir,' cannot be opened');
          writeln(prog,' halting abnormally - dos error code = 2');
          halt(2);
     end;
     while not (hfound and ufound) and not eof(infile) do
     begin
           readln(infile,tmpstring);
           if (tmpstring[1] <> ';') and (tmpstring[1] <> '#') and (tmpstring > '') then
           begin
                tmpstring := mirt(tmpstring);
                uppers := upcasestr(tmpstring);
                if not ufound then
                   ufound := find(userdirtag,uppers,tmpstring,wuserdir);
                if not hfound then
                   hfound := find(hosttag,uppers,tmpstring,hostname);
                if not tzfound then
                   tzfound := find(tztag,uppers,tmpstring,timezone);
          end;
     end; { eof }
     close(infile);
     if (wuserdir = '') then
     begin
        writeln(systime ,' ERROR: No USER directory in Waffle Static file ',wafdir);
        writeln('Using \waffle\user as default');
        wuserdir := '\waffle\user';
     end;
     findwuserdir := wuserdir;
end; {findwuserdir }

procedure dohelp;
{
provide some assistance
}

begin
     writeln('==============',prog,'==============');
     writeln(progname);
     writeln(version);
     writeln('Converts Waffle 1.65 mailboxes into Pegasus mail');
     writeln('Parameters available are :-');
     writeln('   -n[netware mail directory] => eg -nF:\mail (default)');
     writeln('   -d => debug mode - mailbox.f NOT deleted, use ONLY for testing!!');
     writeln('   -u[userid for remote server delivery] => eg guest (default)');
     writeln('   -p[password for remote server delivery userid] (default is no password)');
     writeln('   -l => detailed log of activity');
     writeln('   -? or -h => this help text');
     writeln('eg ',prog,' -ng:\funnymail -uguest -pguest');
     writeln('-n only needs to be set if not the default f:\mail');
     writeln('-u and -p only needed for remote mail delivery - please see');
     writeln('documentation accompanying this package');
     writeln(systime,' ',prog,' terminating');
     halt;
end;

procedure paramerror(s : string);
{
explain use
}
begin
     writeln(upcasestr(s));
     dohelp;
end;

function exists(fn : string) : boolean;
{
return true if fn is a file name
}
var
   s : searchrec;

begin
     findfirst(fn,anyfile ,s);
     exists := (doserror = 0) ;
end;

function hexidtostring(x : hexidtype) : string;
{
translate a 4 byte address into a hex string
}
var
   hex_id : string;
   id : array[1..4] of byte absolute x;

begin
   hex_id := '';
   hex_id := hexdigits[Id[1] shr 4]; { lower nibble }
   hex_id := hex_id + hexdigits[Id[1] and $0F]; { upper }
   hex_id := hex_id + hexdigits[Id[2] shr 4];
   hex_id := hex_id + hexdigits[Id[2] and $0F];
   hex_id := hex_id + hexdigits[Id[3] shr 4];
   hex_id := hex_id + hexdigits[Id[3] and $0F];
   hex_id := hex_id + hexdigits[Id[4] shr 4];
   hex_id := hex_id + hexdigits[Id[4] and $0F];
   hexidtostring := hex_id;
end;

function getmaildir(uname : string) : string;
{
scan bindery for this user and
return hexid plus netmaildir as users mail dir
}
var
   uid : string;
   retcode : integer;

begin
     gethexid(uname,uid,retcode);
     if (retcode = 0) and (uid > '') then
            getmaildir := uid
     else
             getmaildir := '';

(*
     uid := '';
     if standalone then
     begin
          if not allmail then
             uid := uname
          else
          begin
               uid := getenv(pmenv);
               if (uid = '') then
               begin
                     writeln(systime,' ',pmenv,' not set.');
                     writeln('Please read the documentation about setting the ',pmenv );
                     writeln('DOS environmental variable to the user name where incoming mail');
                     writeln('is to be left for Pegasus by Wafpeg from Waffle in Standalone mode');
                     writeln('under the mail directory set on the command line with -n');
                     writeln('Mail will be delivered to subdirectories of the mail directory');
                     writeln('which follow the waffle name(s) - the /A parameter is ignored');
                     uid := uname;
               end; { no pmenv }
          end; { allmail goes to pmenv name }
          getmaildir := uid;
     end
     else
     begin
         gethexid(uname,uid,retcode);
         if (retcode = 0) and (uid > '') then
            getmaildir := uid
         else
             getmaildir := '';
     end; { not standalone }
*)
end; { getmaildir }

procedure scanmaildirs;
{
pass each subdirectory name to the conversion routine
if the name found in the network bindery
}
var
   s : searchrec;


procedure copymail(uname : string);
{
copy contents of waffle mailbox in sdir to
netware mail directory destdir with proper pegasus names
}

var
   remotegateway : boolean;
   remotehandle,remoteserverid : integer;
   regs : registers;
   frsname,fruname,unmaildir,uwmaildir,unetid,usermailbox,userindex,
   userforward,remoteservername,pmailfile : string;
   ffile : text;
   f : file;
   s : string;
   delivered : boolean;

function getnewfilename : string;
{
make a random filename which does not yet exist here
}
var
   fn : string;

function randstr : string;
{
return a 4 character string of random hex digits
Looks at turbo randseed which is a (4 byte) longint
and converts it to a hex string (8 char) as a file name
}
var
   l : longint;
   w : word;
   h : hexidtype absolute l;

begin { randstr }
     w := random(maxint);
     l := randseed; { get longint version }
     randstr := hexidtostring(h);
end; { randstr }

begin { getnewfilename }
     repeat
           fn := unmaildir + '\' + randstr + pmailext;
     until not exists(fn);
     getnewfilename := fn;
end; { getnewfilename }

procedure docopy;
{
read the mailbox file and write out each mail item
notify user if possible
}
const
     crlf : string[2] = chr($0d) + chr($0a);
     lf = chr($0a);

type
    fbuf = array[1..maxbuf] of byte;
var
   index : file of windex;
   outf,mail : file;
   ix : windex;
   pmfile : string;
   retcode,count,dummy : integer;
   toread,mailpos : longint;
   bufsize,i,j : word;
   s : string;
   ifb : fbuf;
   c : char;

begin { docopy }
     mailpos := 0; { pointer into mailbox file }
     count := 0; { number of individual mail items transferred }
     {$i-}
     assign(index,userindex);
     reset(index);
     {$i+}
     dummy := ioresult;
     if (dummy <> 0) then
     begin
          writeln(systime,' Cannot open ',userindex);
          writeln('Is it being used by Waffle or what ???');
          exit;
     end;
     {$i-}
     assign(mail,usermailbox);
     reset(mail,1);
     {$i+}
     dummy := ioresult;
     if (dummy <> 0) then
     begin
          writeln(systime,' Cannot open ',usermailbox);
          writeln('Is it being used by Waffle ???');
          exit;
     end;
     {$i-}
     while not eof(index) do
     begin
          i := 0;
          read(index,ix); { get a set of pointers to the mailfile }
          dummy := ioresult;
          if (dummy = 0) then
          begin { have an index }
               pmfile := getnewfilename;
               assign(outf,pmfile);
               rewrite(outf,1);
               dummy := ioresult;
               if (dummy <> 0) then
               begin
                    writeln(systime,' Problem opening outfile ',pmfile);
                    writeln('Need C (3.x) or CW (2.x) rights to sys:mail');
                    writeln('Mailbox transfer aborted');
                    exit;
               end;
               inc(count);
               s := 'Received: from ' + gateservername + ' by ' + prog + ' ' + ver + crlf;
               if remotegateway then
                  s := s + '          for ' + frsname + '/' + fruname +
                         ' from ' + gateservername
               else
               begin
                    if standalone then
                       s := s + '      for ' + uname + ' on standalone PMail'
                    else
                        s := s + '      for ' + uname + ' on ' + gateservername;
               end;
               s := s + ' ; ' + rfc822date + crlf;
               if (mailpos <= ix.offset) then
               begin { normally expect to be 4 short }
                    blockread(mail,ifb,ix.offset - mailpos);
                    mailpos := ix.offset;
               end
               else
               begin
                    writeln(systime,' error - mail file pointer > start of next message !');
                    writeln(systime,' aborting this mailbox transfer');
                    delivered := false;
                    exit;
               end;
               c := ' ';
               i := 0;
               while (c <> lf) and not eof(mail) do
               begin { find end of 1st line }
                    blockread(mail,c,1);
                    blockwrite(outf,c,1);
                    inc(i);
                    inc(mailpos);
               end;
               blockwrite(outf,s[1],length(s)); { add my mark }
               toread := ix.length - i;
               while (toread > maxbuf) do
               begin { do this until near the end }
                    blockread(mail,ifb,maxbuf);
                    blockwrite(outf,ifb,maxbuf);
                    dec(toread,maxbuf);
                    inc(mailpos,maxbuf);
               end; { big file }
               blockread(mail,ifb,toread); { last bit }
               blockwrite(outf,ifb,toread);
               inc(mailpos,toread); { bump file position pointer }
               close(outf);
               dummy := ioresult;
          end; { got an index record }
     end; { eof index - no more index entries }
     close(index);
     dummy := ioresult;
     close(mail);
     dummy := ioresult;
     if remotegateway then
          writeln(systime,' ',count,' Waffle mail items ',uwmaildir,
          ' ==> ',frsname + '/SYS:' + after(':\',unmaildir))
     else
         writeln(systime,' ',count,' Waffle mail items ',uwmaildir,' ==> ',unmaildir);
     if not some then
        some := true;
     if (count > 0) then
     begin
          delivered := true;
          if not standalone then
          begin
               str(count,s);
               if remotegateway then
                  send_message_to_username(fruname,'New Mail (n='+ s + ') via UUCP/Waffle.',retcode)
               else
                   send_message_to_username(uname,'New Mail (n='+ s + ') via UUCP/Waffle.',retcode);
          end;
     end;
     {$i+}
end; { docopy }

{$ifdef single}

procedure setupforremote(server,user : string);
begin
     writeln('Sorry, this is a single novell server version and cannot deal');
     writeln('with remote netware servers. Contact [e-mail] for');
     writeln('pricing of the source code you need to be able to service multiple');
     writeln('servers with a single waffle. Cheaper than MHS !!');
     halt(1);
end;

{$else}

procedure setupforremote(server,user : string);
{
called if users forward file contains a remote server/userid
Adjusts nmaildir to the mapped drive on this remote server if successful
login and map achieved and does copy. Otherwise leaves mailbox alone
}

begin
     remoteserverid := login(frsname,userobject,remuser,rempass);
     if (remoteserverid <> -1) then
     begin
          if mapremotedrive(remotemapping,'\',remoteserverid,remotehandle) then
          begin
               unetid := getmaildir(fruname);
               if (unetid > '') then
               begin
                    unmaildir := remotenetmaildir + '\' + unetid;
                    if exists(unmaildir) then
                       docopy
                    else
                        writeln(systime,' No Novell mail directory found - ',frsname,'/',fruname);
               end { unetid }
               else
                   writeln(systime,' No netware bindery entry found for user ',frsname,'/',fruname);
               logout_from_file_server(remoteserverid);
               detach_from_file_server(remoteserverid,dummy);
          end { can map }
          else
              writeln(systime,' Unable to map remote ',remotemapping);
     end { can login }
     else
         writeln(systime,' Login to ',frsname,' to deliver mail as ',remuser,'/',rempass,' failed');
     set_preferred_connection_id(defaultserverid);
     chdir(homedir);
end; {setupforremote}
{$endif}

procedure forwardmail;
{
this user has a forward.p file
read it and send a copy of mailbox to each nominated user
these may be remote or local
}
var
   atleastone : boolean;
begin
     atleastone := false;
     {$i-}
     assign(ffile,userforward);
     reset(ffile);
     if (ioresult <> 0) then
        writeln(systime,' Unable to open user forward file ',userforward)
     else
     repeat
        readln(ffile,s);
        dummy := ioresult;
        if (dummy <> 0) then
        begin
             writeln(systime,' Read error on ',userforward);
             exit;
             close(ffile);
        end;
        s := upcasestr(mirt(s));
        if (s > '') and (copy(s,1,1) <> '#') then { not a comment }
        begin
             atleastone := true;
             if (pos('/',s) > 0) then
             begin
                  frsname := before('/',s);
                  fruname := after('/',s);
                  remotegateway := true;
             end
             else
             begin
                  frsname := gateservername;
                  fruname := s;
                  uname := s;
                  remotegateway := false;
             end;
             if (frsname = gateservername) then
             begin  { forward to another user on this server }
                    unetid := getmaildir(fruname);
                    if (unetid > '') then
                    begin
                         unmaildir := netmaildir + '\' + unetid;
                         if exists(unmaildir) then
                             docopy
                         else
                             writeln(systime,' No Novell mail directory found - ',frsname,'/',uname);
                    end
                    else
                         writeln(systime,' No netware bindery entry found for user ',frsname,'/',uname);
             end
             else { forward to another user on another server }
                  setupforremote(frsname,fruname);
        end; { not comment }
     until eof(ffile);
     {$i-}
     if not atleastone then
     begin { oh dear, dud forward.p - send to this uname }
        writeln(systime,' FORWARD.P for ',uname,' HAS NO ENTRIES !!');
        unetid := getmaildir(uname);
        if (unetid > '') then
        begin
             unmaildir := netmaildir + '\' + unetid;
             if exists(unmaildir) then
                 docopy
             else
                 writeln(systime,' No Novell mail directory found - ',uname);
        end
        else
             writeln(systime,' No netware bindery entry found for user ',uname);
    end
end; { forwardmail }


begin { copymail }
      remotegateway := false;
      uwmaildir := userdir + '\' + uname;
      usermailbox := uwmaildir + '\' + mb;
      userindex := uwmaildir + '\' + mbi;
      userforward := uwmaildir + '\' + forwardfilename;
      if exists(usermailbox) then
      begin
           delivered := false;
           if logdirs then
              write(' mailbox found - ',usermailbox,' ');
           if exists(userforward) and not standalone then
           begin
               if logdirs then
                   writeln(' has forward file');
               forwardmail;
               set_preferred_connection_id(defaultserverid);
               chdir(homedir);
           end { has a forward file }
           else
           begin { ordinary delivery }
               if logdirs then
                  writeln(' has no forward file');
               unetid := getmaildir(uname);
               if (unetid > '') then
               begin
                    unmaildir := netmaildir + '\' + unetid;
                    if exists(unmaildir) then
                       docopy
                    else
                        writeln(systime,' No Novell mail directory found - ',unmaildir);
               end
               else
                   writeln(systime,' No netware bindery entry found for user ',uname);
           end; { no forward file }
           if killfile then
           begin { clean up }
               if delivered then
               begin
                    {$i-}
                    assign(f,usermailbox);
                    erase(f);
                    dummy := ioresult;
                    if (dummy <> 0) then
                    begin
                         writeln(systime, ' Error erasing file ',usermailbox);
                         writeln('Is it readonly or do you have erase rights ??? ');
                    end;
                    usermailbox := uwmaildir + '\' + mbi;
                    assign(f,usermailbox);
                    erase(f);
                    dummy := ioresult;
                    if (dummy <> 0) then
                    begin
                         writeln(systime,' Error erasing file ',usermailbox);
                         writeln('Is it readonly or do you have erase rights ??? ');
                    end;
                    {$i+}
               end { delivered }
               else
                   writeln(systime,' ',usermailbox,' NOT deleted as Mail NOT DELIVERED');
           end
           else
               writeln(systime,' ',usermailbox,' NOT deleted - /d parameter supplied');
          end { no waffle mailbox }
      else
      begin
          if debug then
             writeln(systime, ' No mailbox found - ',usermailbox);
          if logdirs then
              writeln(' no mailbox found')
      end;
end; { copymail }

begin { scanmaildirs }
     findfirst(userdir + '\*.*',directory,s);
     while (doserror = 0) do
     begin
          if (s.name <> '.') and (s.name <> '..') then
          begin
               if logdirs then
                  write('Processing ',s.name);
               copymail(s.name);
          end;
          findnext(s);
     end;
end; { scanmaildirs }

begin { wafpeg main }
     if (pos('ß',ver) <> 0) then
     begin
          writeln(copyright);
          writeln(copyright2);
          writeln('This is a BETA TEST VERSION - please do not distribute !!!');
     end;
     assign(input,''); { enable redirection of log output }
     reset(input);
     assign(output,'');
     rewrite(output);
     randomize;
     userdir := findwuserdir;
     j := length(userdir);
     if (j > 1) and (copy(userdir,j,1) = '\') then
        userdir := copy(userdir,1,pred(j));
     if not apiavailable then
     begin
          standalone := true;
          netmaildir := userdir;
     end;
     killfile := true;
     for i := 1 to paramcount do
     begin
          s := paramstr(i);
          c := upcase(s[2]); { eg /N }
          case c of
          'N' : begin
                     netmaildir := copy(s,3,999);
                     j := length(netmaildir);
                     if (j > 1) and (copy(netmaildir,j,1) = '\') then
                        netmaildir := copy(netmaildir,1,pred(j));
                end;
          'D' : killfile := false;
          'U' : remuser := copy(s,3,999);
          'P' : rempass := copy(s,3,999);
          'H','?' : dohelp;
          'L' : logdirs := true;
          'A' : allmail := true;

          else
              writeln(systime,' Bad parameter (#',i,') = ',s);
          end;
     end;
     if not exists(netmaildir + '\*.*') then
     begin
       if (standalone) then
       begin
             writeln('In standalone mode, the -n parameter defaults to the');
             writeln('waffle static file User directory (',userdir,')');
             writeln('Please check the documentation !');
        end;
        paramerror('Cannot locate netware mail directory ' + netmaildir);
     end;
     if not exists(userdir) then
        paramerror('Cannot locate waffle user directory ' + userdir);
     if not standalone then
     begin
          get_default_connection_id(defaultserverid);
          get_file_server_name(defaultserverid,gateservername);
          getdir(0,homedir);
          if allmail then
          begin
               writeln('Warning - parameter error');
               writeln('The -a parameter (All mail) is ONLY meaningful in standalone');
               writeln('mode - ignored as Netware shell detected');
          end;
     end
     else
          gateservername := 'Waffle on ' + hostname ;
     writeln('|');
     writeln(progname,' invoked ',rfc822date);
     writeln(version);
     if paramcount < 1 then
     begin
          writeln(systime, ' Using ',userdir,' as waffle user directory');
          writeln('and ',netmaildir,' as netware mail directory');
     end;
     if not killfile then
     begin
        writeln(systime,' In NON KILL mode - processed mailboxes will NOT BE DELETED !');
        writeln('Remember, mail will be repeatedly delivered until the -d flag is NOT used');
     end;
     scanmaildirs;
     if not some then
        writeln(systime,' (Yawn) Nothing to do');
end.
{
end wafpeg.pas
rml started June 1992 - derived from Brendan Murray's FILTER.C
}